home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / search.tcl < prev    next >
Encoding:
Text File  |  2001-01-25  |  24.0 KB  |  785 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "search.tcl"
  6.  #                                    created: 13/6/95 {8:56:37 pm} 
  7.  #                                last update: 01/25/2001 {23:26:54 PM} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  #  Description: 
  15.  # 
  16.  # All procedures which deal with search/reg-search/grep type stuff
  17.  # in Alpha.
  18.  # ###################################################################
  19.  ##
  20.  
  21. namespace eval text {}
  22. namespace eval quote {}
  23. namespace eval file {}
  24. namespace eval search {}
  25.  
  26. proc quickFind {} {search::interactive exact}
  27. proc reverseQuickFind {} {search::interactive exact 0}
  28. proc quickFindRegexp {} {search::interactive regexp}
  29.  
  30. #================================================================================
  31. # 'greplist' and 'grepfset' are used for batch searching from the "find" dialog.
  32. #  Hence, you really shouldn't mess with them unless you know what you are doing.
  33. #================================================================================
  34. proc greplist {args} {
  35.     global tileLeft tileTop tileWidth tileHeight errorHeight
  36.     
  37.     set recurse [lindex $args 0]
  38.     set word [lindex $args 1]
  39.     set args [lrange $args 2 end]
  40.     
  41.     set num [expr {[llength $args] - 2}]
  42.     set exp [lindex $args $num]
  43.     set arglist [lindex $args [expr {$num + 1}]]
  44.     
  45.     set opened 0
  46.     set cid [scancontext create]
  47.     
  48.     set cmd [lrange $args 0 [expr {$num - 1}]]
  49.     eval scanmatch $cmd {$cid $exp {
  50.     if {!$word || [regexp -nocase -- "(^|\[^a-zA-Z0-9\])${exp}(\[^a-zA-Z0-9\]|\$)" $matchInfo(line)]} {
  51.         if {!$opened} {
  52.         set opened 1
  53.         win::SetProportions
  54.         set w [new -n {* Batch Find *} -m Brws -g $tileLeft $tileTop $tileWidth $errorHeight -tabsize 8]
  55.         insertText "(<cr> to go to match)\r-----\r"
  56.         }
  57.         set l [expr {20 - [string length [file tail $f]]}]
  58.         regsub -all "\t" $matchInfo(line) "  " text
  59.         insertText -w $w "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): ${text}\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\r"}
  60.     }
  61.     }
  62.     
  63.     foreach f $arglist {
  64.     message [file tail $f]
  65.     if {![catch {set fid [alphaOpen $f]}]} {
  66.         scanfile $cid $fid
  67.         close $fid
  68.     }
  69.     }
  70.     scancontext delete $cid
  71.     
  72.     if {$opened} {
  73.     select [nextLineStart [nextLineStart [minPos]]] [nextLineStart [nextLineStart [nextLineStart [minPos]]]]
  74.     setWinInfo dirty 0
  75.     setWinInfo read-only 1
  76.     }
  77.     message ""
  78. }
  79.  
  80.  
  81. ## 
  82.  # -------------------------------------------------------------------------
  83.  # 
  84.  # "grepfset" --
  85.  # 
  86.  #  args: wordmatch ?-nocase? expression fileset
  87.  #  Obviously we ignore wordmatch
  88.  #  
  89.  #  If the 'Grep' box was set, then the search item is _not_ quoted.
  90.  #  
  91.  #  Non grep searching problems:
  92.  #  
  93.  #  If it wasn't set, then some backslash quoting takes place. 
  94.  #  (The chars: \.+*[]$^ are all quoted)
  95.  #  Unfortunately, this latter case is done incorrectly, so most
  96.  #  non-grep searches which contain a grep-sensitive character fail.
  97.  #  The quoting should use the equivalent of the procedure 'quote::Regfind'
  98.  #  but it doesn't quote () and perhaps other important characters.
  99.  #  
  100.  #  Even worse, if the string contained any '{' it never reaches this
  101.  #  procedure (there must be an internal error due to bad quoting).
  102.  # 
  103.  # -------------------------------------------------------------------------
  104.  ##
  105. proc grepfset {args} {
  106.     set num [expr {[llength $args] - 2}]
  107.     # the 'find' expression
  108.     set exp [lindex $args $num]
  109.     # the fileset
  110.     set fset [lindex $args [expr {$num + 1}]]
  111.     eval greplist 0 [lrange $args 0 [expr {$num-1}]] {$exp [getFileSet $fset]}
  112. }
  113.  
  114. proc grep {exp args} {
  115.     set files {}
  116.     foreach arg $args {
  117.     eval lappend files [glob -types TEXT -nocomplain -- $arg]
  118.     }
  119.     if {![llength $files]} {return "No files matched pattern"}
  120.     set cid [scancontext create]
  121.     scanmatch $cid $exp {
  122.     if {!$blah} {
  123.         set blah 1
  124.         set lines "(<cr> to go to match)\n"
  125.     }
  126.     set l [expr {20 - [string length [file tail $f]]}]
  127.     regsub -all "\t" $matchInfo(line) "  " text
  128.     append lines "\"[file tail $f]\"[format "%$l\s" ""]; Line $matchInfo(linenum): ${text}\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$f\n"
  129.     }
  130.     
  131.     set blah 0
  132.     set lines ""
  133.     
  134.     foreach f $files {
  135.     if {![catch {set fid [alphaOpen $f]}]} {
  136.         message [file tail $f]
  137.         scanfile $cid $fid
  138.         close $fid
  139.     }
  140.     }
  141.     scancontext delete $cid
  142.     return [string trimright $lines "\r"]
  143. }
  144.  
  145. proc grepnames {exp args} {
  146.     set files {}
  147.     foreach arg $args {
  148.     eval lappend files [glob -types TEXT -nocomplain -- $arg]
  149.     }
  150.     if {![llength $files]} {return "No files matched pattern"}
  151.     set cid [scancontext create]
  152.     scanmatch $cid $exp {
  153.     lappend filenames $f
  154.     }
  155.     set filenames ""
  156.     foreach f $files {
  157.     if {![catch {set fid [alphaOpen $f]}]} {
  158.         message [file tail $f]
  159.         scanfile $cid $fid
  160.         close $fid
  161.     }
  162.     }
  163.     scancontext delete $cid
  164.     return $filenames
  165. }
  166.  
  167. ## 
  168.  # -------------------------------------------------------------------------
  169.  # 
  170.  # "performSearch" --
  171.  # 
  172.  #  Call this procedure in Tcl code which wants to use the standard procs
  173.  #  like 'replaceAll' to ensure flags like multi-file batch replace are
  174.  #  cleared.  Otherwise replaceAll might not have the desired effect.
  175.  #  
  176.  #  This proc is overridden by code (such as supersearch) which might
  177.  #  otherwise cause the nasty behaviour.
  178.  # -------------------------------------------------------------------------
  179.  ##
  180. proc performSearch {args} {
  181.     eval select [uplevel 1 search $args]
  182. }
  183.  
  184. proc findBatch {forward ignore regexp word pat} {
  185.     matchingLines $pat $forward $ignore $word $regexp 
  186. }
  187.  
  188. ## 
  189.  # -------------------------------------------------------------------------
  190.  #     
  191.  #    "containsSpace"    --
  192.  #    
  193.  #  Does the given text contain any spaces?  In general we don't
  194.  #  complete commands which contain spaces (although perhaps future
  195.  #  extensions should do this: e.g. cycle through 'string match',
  196.  #  'string compare',…)
  197.  #     
  198.  # -------------------------------------------------------------------------
  199.  ##
  200. proc containsSpace { cmd } { return [string match "*\[ \t\]*" $cmd] }
  201. proc containsReturn { cmd } { return [string match "*\[\r\n\]*" $cmd] }
  202.  
  203. ## 
  204.  # -------------------------------------------------------------------------
  205.  #     
  206.  #  "findPatJustBefore" --
  207.  #    
  208.  #  Utility proc to check whether the first occurrence of 'findpat' to
  209.  #  the left of 'pos' is actually an occurrence of 'pat'.  It can be
  210.  #  used to check if we're part of an '} else {' (see TclelectricLeft)
  211.  #  or in TeX mode if we're in the argument of a '\label{' or '\ref{'
  212.  #  (see smartScripts) for example.
  213.  #     
  214.  #  A typical usage has the regexp 'pat' end in '$', so that it must
  215.  #  match all the text up to 'pos'.  'matchw' can be used to store the
  216.  #  first '()' pair match in the regexp.
  217.  #     
  218.  #  New: maxlook restricts how far this proc will search.  The default
  219.  #  is only 100 (not the entire file), after all this proc is supposed
  220.  #  to look 'just before'!
  221.  # -------------------------------------------------------------------------
  222.  ##
  223. proc findPatJustBefore { findpat pat {pos ""} {matchw ""} {maxlook 100} } {
  224.     if { $pos == "" } {set pos [getPos] }
  225.     if {[pos::compare $pos == [maxPos]]} { set pos [pos::math $pos - 1]}
  226.     if { $matchw != "" } { upvar $matchw word }
  227.     if {[llength [set res [search -s -n -f 0 -r 1 -l [pos::math $pos - $maxlook] -- "$findpat" $pos]]]} {
  228.     if {[regexp -- "$pat" [getText [lindex $res 0] $pos] dum word]} {
  229.         return [lindex $res 0]
  230.     }
  231.     }
  232.     return
  233. }
  234. # Look for pattern in filename after position afterPos and, if found, 
  235. # open the file quietly and select the pattern
  236. # author Jonathan Guyer
  237. proc selectPatternInFile {filename pattern {afterPos ""}} {
  238.     if {$afterPos == ""} {set afterPos [minPos]}
  239.     set searchResult [searchInFile $filename $pattern 1]
  240.     if {[pos::compare [lindex $searchResult 0] >= $afterPos]} {
  241.     placeBookmark
  242.     file::openQuietly $filename
  243.     eval select $searchResult
  244.     message "press <Ctrl .> to return to original cursor position"
  245.     return 1
  246.     } else {
  247.     return 0
  248.     }
  249. }
  250.  
  251. proc text::replace {old new {fwd 1} {pos ""}} {
  252.     if {$pos == ""} {set pos [getPos]}
  253.     set m [search -s -f $fwd -m 0 -r 0 -- $old $pos]
  254.     eval replaceText $m [list $new]
  255. }
  256.  
  257. proc isSelection {} {
  258.     return [pos::compare [getPos] != [selEnd]]
  259. }
  260. proc searchStart {} {
  261.     global search_start
  262.     select [getPos]
  263.     setMark
  264.     if {[catch {goto $search_start}]} {message "No previous search"}
  265. }
  266. set {patternLibrary(Pascal to C Comments)}      { {\{([^\}]*)\}}    {/* \1 */} }
  267. set {patternLibrary(C++ to C Comments)}        { {//(.*)}    {/* \1 */} }
  268. set {patternLibrary(Space Runs to Tabs)}    { { +}    {\t}}
  269.  
  270. proc getPatternLibrary {} {
  271.     global patternLibrary
  272.     
  273.     foreach nm [array names patternLibrary] {
  274.     lappend nms [concat [list $nm] $patternLibrary($nm)]
  275.     }
  276.     return $nms
  277. }
  278.  
  279. # This fails if, say, search string is '\{[^}]'
  280. # This is because the '}' ends the first argument because this
  281. # procedure is presumably called internally with incorrect quoting.
  282. proc rememberPatternHook {search replace} {
  283.     global patternLibrary modifiedArrayElements
  284.     if {[catch {set name [prompt "New pattern's name?" ""]}]} {
  285.     return ""
  286.     }
  287.     lappend modifiedArrayElements [list $name patternLibrary]
  288.     set patternLibrary($name) [list $search $replace]
  289.     return $name
  290. }
  291.  
  292. proc deletePatternHook {} {
  293.     global patternLibrary modifiedArrayElements
  294.     set temp [list prompt "Delete which pattern?" [lindex [array names patternLibrary] 0] "Pats:"]
  295.     set name [eval [concat $temp [array names patternLibrary]]]
  296.     lappend modifiedArrayElements [list $name patternLibrary]
  297.     unset patternLibrary($name)
  298. }
  299.  
  300.  
  301. ## 
  302.  # -------------------------------------------------------------------------
  303.  # 
  304.  # "search::interactive" -- general interactive searching
  305.  # 
  306.  # This version allows class shorthands (\d \s \w \D \S \W), 
  307.  # word anchors (\b), and some aliases of the machine dependent 
  308.  # control characters (\a \f \e \n \r \t). Therefore, 
  309.  # we need two prompts, one for when we have a valid pattern, and one 
  310.  # for when the pattern has gone invalid (most likely due to starting 
  311.  # to enter one of the above patterns). 
  312.  # 
  313.  # The Return key and unknown key combinations exit the search, leaving 
  314.  # the point at its current position. You can then use 'exchangePointAndMark'
  315.  # (cntrl-x, cntrl-x -in emacs keyset) to jump back and forth between where
  316.  # the search started from and where the search ended.
  317.  # 
  318.  # Known key combinations (e.g., arrow keys, many emacs navigation keys)
  319.  # exit the search and perform the appropriate action. The mark is set to
  320.  # the last successful search, so 'exchangePointAndMark' does NOT take you
  321.  # to the start of the search.
  322.  # 
  323.  # The Escape key or abortEm (cntrl-g in emacs) "aborts" the search,
  324.  # returning the cursor to the point where the search started from.
  325.  # Use 'exchangePointAndMark' to jump to the last found match.
  326.  # 
  327.  # The next occurrence of the current pattern can be matched by typing 
  328.  # either control-s (to get the next occurence forward), or control-r 
  329.  # (to get the the next occurrence backward)
  330.  #
  331.  # Also, after aborting or exiting, the search string is left in the Find
  332.  # dialog, and so you can use 'findAgain' or cntrl-s or cntrl-r to continue
  333.  # the search. Be aware that the Find dialog starts out with a default of 
  334.  # <Grep=OFF>.
  335.  #  
  336.  # Original Author: Mark Nagata
  337.  # modifications  : Tom Fetherston
  338.  # modifications  : Vince Darley, so works with or without regexp
  339.  # -------------------------------------------------------------------------
  340.  ##
  341.  
  342. proc search::interactive {{type "exact"} {direction 1}} {
  343.     set ignoreCase 1
  344.     set interpretBackslash 0
  345.     set patt ""
  346.     set pos [getPos]
  347.     lappend history [list "" [list $pos $pos] 1]
  348.     
  349.     set done 0
  350.     while {!$done} {
  351.     if {$type == "regexp"} {
  352.         # check pattern validatity
  353.         if {[catch {regexp -- $patt {} dmy} dmy]} {        
  354.         set prompt "building->: $patt"
  355.         } else {
  356.         set prompt "regIsearch: $patt"
  357.         }
  358.     } else {
  359.         set prompt "search: $patt"
  360.     }
  361.     set proc [list search::interactiveKeypress $type $direction]
  362.     set done 1
  363.     switch -- [catch [list status::prompt -appendvar patt -command $proc -add anything $prompt] res] {
  364.         0 {
  365.         # got a keystroke that triggered a normal end (e.g. <return>)
  366.         set res "<return>"
  367.         set tmp [getPos]
  368.         goto $pos
  369.         setMark
  370.         goto $tmp
  371.         }
  372.         1 {
  373.         # an error was generated
  374.         if {[string match "missing close-brace" $res]} {
  375.             # must have typed a slash, so:
  376.             append patt "\\"
  377.             set done 0
  378.         } elseif {[string match "invoked \"break\" outside of a loop" $res]} {
  379.             # do nothing
  380.         } elseif {[string match "abort*" $res]} {
  381.             if {[package::active emacs]} { append res ". ctrl-x ctrl-x goes to last found" }
  382.             goto $pos
  383.         } elseif {[string match "unknown*" $res]} {
  384.             if {[package::active emacs]} { append res ". ctrl-x ctrl-x goes to search start" }
  385.             set tmp [getPos]
  386.             goto $pos
  387.             setMark
  388.             goto $tmp
  389.         } else {
  390.             # unknown error -- exit
  391.         }
  392.         }
  393.         default {
  394.         set done 1
  395.         }
  396.     }
  397.     }
  398.     message "Search $patt: exited with $res."
  399. }
  400.  
  401. ## 
  402.  # -------------------------------------------------------------------------
  403.  # 
  404.  # "search::interactiveKeypress" -- handle isearch, rsearch, regIsearch
  405.  # 
  406.  #  This proc handles each keypress while running a regIsearch. It has been 
  407.  #  modified from Mark Nagata's original to provide next ocurrence 
  408.  #  before/after current, and support for key bindings whose navigation or 
  409.  #  text manipulation functionality makes sense with respect to a regIsearch.
  410.  #  
  411.  #  closest occurence before current match    
  412.  #    - command-option g & cntrl-r (mnemonic 'reverse')
  413.  #  closest occurence after current match
  414.  #    - command g & cntrl-s (mnemonic 'successor')
  415.  #  
  416.  #                         Text Naviagation
  417.  #  forwardChar (aborts and leaves cursor after last match)
  418.  #    - right arrow & cntrl-f (emacs)
  419.  #  backwardChar (aborts and leaves cursor before last match)
  420.  #    - left arrow & cntrl-b (emacs)
  421.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  422.  #      containing the last match)
  423.  #    - cmd left arrow & cntrl-a (emacs)
  424.  #  beginningOfLine (aborts and moves cursors to the start of the line 
  425.  #      containing the last match)
  426.  #    - cmd right arrow & cntrl-e (emacs)
  427.  #  centerRedraw (moves selection to center, without aborting)
  428.  #   - cntrl-l
  429.  #  insertToTop (moves selection to top, without aborting)
  430.  #   - cntrl-t
  431.  #  ctrl-w adds the rest of the current word to the search string.
  432.  #  
  433.  #                         Text Manipulation
  434.  #  deleteSelection (aborts and deletes selection)
  435.  #    - cntrl-d (emacs)
  436.  #  killLine (aborts and deletes from start of selection to end of line)
  437.  #    - cntrl-k (emacs)
  438.  #    
  439.  #    Changing the search type:
  440.  #    
  441.  #  ctrl-i switches the case-sensitivity of the current search
  442.  #  ctrl-backslash toggles interpretation of \n,\r,\t in non-regexp searches
  443.  # -------------------------------------------------------------------------
  444.  ##
  445. proc search::interactiveKeypress {type dir {key 0} {mod 0}} {
  446.     set direction {}
  447.     
  448.     # build a string that represents all the modifiers pressed:
  449.     # checking in this order cmd, shift, option, and ctrl
  450.     if {[expr {$mod & 1}]} { append t "c" } else { append t "_" }
  451.     if {[expr {$mod & 34}]} { append t "s" } else { append t "_" }
  452.     if {[expr {$mod & 72}]} { append t "o" } else { append t "_" }
  453.     if {[expr {$mod & 144}]} { append t "z" } else { append t "_" }
  454.     if {[string length $key]} {
  455.     scan $key %c decVal
  456.     } else {
  457.     # No key showed up.  Probably running on Alphatk
  458.     error "no key press"
  459.     }
  460.     #tclLog "\r$key $t $mod $decVal"
  461.     upvar patt pat
  462.     switch -- $t {
  463.     "____" {
  464.         switch -- $decVal {
  465.         8  {
  466.             set len [string length $pat]
  467.             if {$len > 0} {
  468.             set pat [string range $pat 0 [expr {$len-2}]]
  469.             set key ""
  470.             set backtrack 1
  471.             } else {
  472.             error "deletion of all characters"
  473.             }
  474.         }
  475.         1 { beginningOfBuffer;  error "navigation key"; # home; }
  476.         4 { endOfBuffer;  error "navigation key"; # end; }
  477.         11 { pageBack;  error "navigation key"; # page up; }
  478.         12 { pageForward;  error "navigation key"; # page down; }
  479.         29 { forwardChar; error "navigation key"; # right arrow; }
  480.         28 { backwardChar; error "navigation key"; # left arrow; }
  481.         30 { previousLine; error "navigation key"; # up arrow; }
  482.         31 { nextLine; error "navigation key"; # down arrow; }
  483.         27 { error "abort (esc key)"; # escape; }
  484.         13 { error "<return> key"; }
  485.         }
  486.     }
  487.     }
  488.     switch -- $t {
  489.     "____" - 
  490.     "_s__" {
  491.         if {0 && $curr != ""} {
  492.         while {[string compare [string range $pat [string last $curr $pat] end] $curr] != 0} {
  493.             set newEnd [expr {[string length $pat] - 2}]
  494.             if {$newEnd < 0} {
  495.             error "deletion of all characters"
  496.             } 
  497.             set pat [string range $pat 0 $newEnd] 
  498.             set backtrack 1
  499.         }
  500.         } 
  501.         
  502.         set preAppend $pat
  503.         append pat $key
  504.         if {$type == "regexp"} {
  505.         if {[catch {regexp -- $pat {} dmy} res]} {
  506.             message "building->: $preAppend"
  507.             return $key
  508.         }
  509.         }
  510.         set direction $dir
  511.         # This is a continuing search from the current point
  512.         set inplace 1
  513.     }
  514.     "c___" {
  515.         switch -- $decVal {
  516.         101 { 
  517.             # cmd-e = enter search string
  518.             searchString $pat
  519.             return {}
  520.         }
  521.         103 { set direction 1;        # (cmd g); }
  522.         28 { beginningOfLine; error "navigation key"; # cmd left arrow; }
  523.         29 { endOfLine; error "navigation key"; # cmd right arrow; }
  524.         default { error "unknown cmd key" }
  525.         }
  526.         
  527.     }
  528.     "__o_" {
  529.         if {[package::active emacs]} {
  530.         switch -- $decVal {
  531.             2 - 186 { backwardWord; error "emacs delete word (opt-d)"; # opt-b; }
  532.             4 - 182 { deleteWord; error "emacs delete word (opt-d)"; # opt-d; }
  533.             6 - 196 { forwardWord; error "emacs forward word (opt-f)"; # opt-f; }
  534.         }
  535.         } 
  536.     }
  537.     "___z" {
  538.         # If the user is using the emacs key bindings, check for ones that 
  539.         # make sense. All other control key combinations abort
  540.         if {[package::active emacs]} {
  541.         switch -- $decVal {
  542.             1 { beginningOfLine; error "emacs beginning of line (cnt-a)"; # cntrl-a; }
  543.             2 { backwardChar; error "emacs backward char (cnt-b)"; # cntrl-b; }
  544.             4 { deleteSelection; error "emacs delete selection (cnt-d)"; # cntrl-d; }
  545.             5 { endOfLine; error "emacs end of line (cnt-e)"; # cntrl-e; }
  546.             6 { forwardChar; error "emacs forward char (cnt-f)"; # cntrl-f; }
  547.             11 - 107 { killLine; error "emacs kill line (cnt-k)"; # cntrl-k; }
  548.             12 - 108 { centerRedraw; return {};    # cntrl-l; }
  549.             14 { backwardChar; nextLine; error "emacs next line (cnt-n)"; }
  550.             15 { openLine; error "emacs open line (cnt-o)"; # cntrl-o; }
  551.             16 { backwardChar; previousLine; error "emacs previous line (cnt-p)"; }
  552.         }
  553.         } 
  554.         # See if user has requested to find another match, either searchForward 
  555.         # (cntrl-s) or reverseSearch (cntrl-r). Set flag accordingly
  556.         switch -- $decVal {
  557.         18 - 114 - 19 - 115 { 
  558.             # (ctrl-r, ctrl-s)
  559.             if {![string length $pat]} { 
  560.             # load previous search string if current is empty
  561.             set pat [searchString]
  562.             }
  563.             switch -- $decVal {
  564.             18 - 114 { set direction 0; # reverse; }
  565.             19 - 115 { set direction 1; # forward; }
  566.             default {}
  567.             }
  568.         }
  569.         20 - 116 {
  570.             insertToTop; #cntl-t; 
  571.         }
  572.         28 {
  573.             # ctrl-backslash : toggle \n\r\t interpretation
  574.             upvar interpretBackslash ib
  575.             set ib [expr {1-$ib}]
  576.             set direction $dir
  577.             set inplace 1
  578.         }
  579.         8 - 103 {
  580.             # cntrl-g
  581.             error "abort (ctrl-g)"
  582.         }
  583.         9 - 105 {
  584.             # ctrl-i : change case-sensitivity
  585.             upvar ignoreCase ign
  586.             set ign [expr {1-$ign}]
  587.             set direction $dir
  588.             set inplace 1
  589.         }
  590.         23 - 119 {
  591.             # ctrl-w : add next word
  592.             set _p [getPos]
  593.             set _q [pos::math $_p + [string length [getSelect]]]
  594.             goto $_q
  595.             forwardWord
  596.             append pat [getText $_q [getPos]]
  597.             goto $_p
  598.             set direction $dir
  599.             set inplace 1
  600.         }
  601.         default { error "unknown cntrl key" }
  602.         }
  603.     }
  604.     "c_o_" {
  605.         switch -- $decVal {
  606.         169 { 
  607.             # (cmd-opt 'g')
  608.             set direction 0 
  609.         }
  610.         default { error "unknown cmd-option key" }
  611.         }
  612.         
  613.     }
  614.     "default" {
  615.         error "unknown modifier key"
  616.     }
  617.     }
  618.     # handle direction flag if it got set above
  619.     if {$direction != ""} {
  620.     if {$type == "regexp"} {
  621.         message "regIsearch: $pat " 
  622.     } else {
  623.         message "search: $pat " 
  624.     }
  625.     upvar ignoreCase ign
  626.     if {![info exists inplace]} {
  627.         if {$direction} {
  628.         set search_start [pos::math [getPos] + 1]
  629.         } else {
  630.         set search_start [pos::math [getPos] - 1]
  631.         }
  632.     } else {
  633.         set search_start [getPos]
  634.     }
  635.     upvar history hist
  636.     if {[info exists backtrack]} {
  637.         while {[llength $hist] > 1} {
  638.         set hist [lrange $hist 0 [expr {[llength $hist]} -2]]
  639.         if {[llength $hist]} {
  640.             set last [lindex $hist end]
  641.             if {[llength $last] == 1} {
  642.             # search failed
  643.             set failed 1
  644.             continue
  645.             }
  646.             # Only if we haven't failed do we check the in-place
  647.             # flag (list index 2).
  648.             if {![info exists failed]} {
  649.             if {![lindex $last 2]} {
  650.                 continue
  651.             }
  652.             }
  653.             break
  654.         } else {
  655.             # error "Probably shouldn't get here"
  656.             # Avoid infinite loop in some odd cases.
  657.             break
  658.         }
  659.         }
  660.         set last [lindex $hist end]
  661.         set pat [lindex $last 0]
  662.         eval select [lindex $last 1]
  663.     } else {
  664.         if {$type == "regexp"} {
  665.         set searchResult [search -n -f $direction -m 0 -i $ign -r 1 -- $pat $search_start]
  666.         } else {
  667.         upvar interpretBackslash ib
  668.         if {$ib} {
  669.             set spat $pat
  670.             regsub -all "\\\\n" $spat "\n" spat
  671.             regsub -all "\\\\r" $spat "\r" spat
  672.             regsub -all "\\\\t" $spat "\t" spat
  673.             set searchResult [search -n -f $direction -m 0 -i $ign -r 0 -- $spat $search_start]
  674.         } else {
  675.             set searchResult [search -n -f $direction -m 0 -i $ign -r 0 -- $pat $search_start]
  676.         }
  677.         }
  678.         if {[llength $searchResult] == 0} {
  679.         lappend hist [list "failed"]
  680.         beep
  681.         } else {
  682.         lappend hist [list $pat $searchResult [info exists inplace]]
  683.         eval select $searchResult
  684.         }
  685.     }
  686.     return {}
  687.     }
  688. }
  689.  
  690. proc nextFunc {} {
  691.     mode::proc searchFunc 1
  692. }
  693.  
  694. proc prevFunc {} {
  695.     mode::proc searchFunc 0
  696. }
  697.  
  698. proc ::searchFunc {dir} {
  699.     global funcExpr mode
  700.     global ${mode}modeVars
  701.     
  702.     if {![info exists ${mode}modeVars(funcExpr)]} {
  703.     # for modes that have no functions, just use filemarks
  704.     findViaFileMarks $dir
  705.     return
  706.     }
  707.     
  708.     set pos [getPos]
  709.     select $pos $pos
  710.     
  711.     if {$dir} {
  712.     set pos [pos::math $pos + 1]
  713.     set lastStop [maxPos]
  714.     } else {
  715.     set pos [pos::math $pos - 1]
  716.     set lastStop [minPos]
  717.     }
  718.     if {![catch {search -s -f $dir -i 1 -r 1 -- $funcExpr $pos} res]} {
  719.     eval select $res
  720.     } else {
  721.     goto $lastStop
  722.     if {$dir} {
  723.         message "At bottom, no more functions in this direction"
  724.     } else {
  725.         message "At top, no more functions in this direction"
  726.     }
  727.     }
  728. }
  729.  
  730. proc findViaFileMarks {dir} {
  731.     set pos [getPos] 
  732.     set markAbovePos ""
  733.     set markBelowPos ""
  734.     
  735.     set nm [getNamedMarks]
  736.     foreach n $nm {
  737.     set posOf_n [lindex $n 3]
  738.     if { $posOf_n < $pos } {
  739.         set markAbovePos [lindex $n 0]
  740.     } elseif { $posOf_n == $pos } {
  741.         continue 
  742.     } else {
  743.         set markBelowPos [lindex $n 0]
  744.         break
  745.     }
  746.     }
  747.     
  748.     if {$dir} {
  749.     if {$markBelowPos != ""} {
  750.         gotoMark $markBelowPos 
  751.     }
  752.     } else {
  753.     if {$markAbovePos != ""} {
  754.         gotoMark $markAbovePos 
  755.     }
  756.     }
  757. }
  758.  
  759. ###
  760. #===========================================================================
  761. # Juan Falgueras (7/Abril/93)
  762. # you only need to select (or not) text and move *forward and backward*
  763. # faster than iSearch (if you have there the |word wo|rd..).
  764. #===========================================================================
  765.  
  766. proc quickSearch {dir} {
  767.     if {[pos::compare [selEnd] == [getPos]]} {
  768.     backwardChar
  769.     hiliteWord
  770.     }
  771.     set myPos [expr {$dir ? [selEnd] : [pos::math [getPos] - 1]}]
  772.     set text [getSelect]
  773.     set searchResult [search -s -n -f $dir -m 0 -i 1 -r 0 $text $myPos]
  774.     if {[llength $searchResult] == 0} {
  775.     beep
  776.     message [concat [expr {$dir ? "->" : "<-"}] '$text' " not found"]
  777.     return 0
  778.     } else {
  779.     message [concat [expr {$dir ? "->" : "<-"}] '$text']
  780.     eval select $searchResult
  781.     return 1
  782.     }
  783. }
  784.  
  785.